home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol218 / updatmar.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-11-30  |  11.6 KB  |  416 lines
  1. 100  REM UPDATMAR Program
  2. 110  REM Data Entry to the Marriages File
  3. 120  REM By:  Melvin O. Duke.  Last Updated 19 February 1986.
  4. 200  REM Screen Definitions
  5. 210  WIDTH "scrn:", 80
  6. 220  SCREEN S1,S2,S3,S4
  7. 600  REM Titles
  8. 610  TITLE$ = "Update the Marriages File"
  9. 620  TITLE$ = TITLE$ + " ON DISPLAY"
  10. 700  REM Terminate if not called from the Menu
  11. 710  IF DD.MENU$ <> "" THEN 770
  12. 720  COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
  13. 730  PRINT "Cannot run the"
  14. 740  PRINT TITLE$
  15. 750  PRINT "Program, unless selected from the MENU"
  16. 760  END
  17. 770  REM OK
  18. 1000  REM Produce the first screen
  19. 1010  KEY ON : CLS : KEY OFF
  20. 1020  REM Draw the outer double box
  21. 1030  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1300
  22. 1040  REM Find the title location
  23. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  24. 1060  REM Draw the title box
  25. 1070  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1500
  26. 1080  REM Print the title
  27. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  28. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  29. 1230  REM Draw the Copyright box
  30. 1240  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1300
  31. 1250  REM Print the Copyright
  32. 1260  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  33. 1270  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  34. 1280  GOTO 1700
  35. 1300  REM subroutine to print a double box
  36. 1310  COLOR P
  37. 1320  FOR I = R1 + 1 TO R2 - 1
  38. 1330   LOCATE I, C1 : PRINT CHR$(186);
  39. 1340   LOCATE I, C2 : PRINT CHR$(186);
  40. 1350  NEXT I
  41. 1360  FOR J = C1 + 1 TO C2 - 1
  42. 1370   LOCATE R1, J : PRINT CHR$(205);
  43. 1380   LOCATE R2, J : PRINT CHR$(205);
  44. 1390  NEXT J
  45. 1400   LOCATE R1, C1 : PRINT CHR$(201);
  46. 1410   LOCATE R1, C2 : PRINT CHR$(187);
  47. 1420   LOCATE R2, C1 : PRINT CHR$(200);
  48. 1430   LOCATE R2, C2 : PRINT CHR$(188);
  49. 1440  COLOR W
  50. 1450  RETURN
  51. 1500  REM subroutine to print a single box
  52. 1510  COLOR B
  53. 1520  FOR I = R1 + 1 TO R2 - 1
  54. 1530   LOCATE I, C1 : PRINT CHR$(179);
  55. 1540   LOCATE I, C2 : PRINT CHR$(179);
  56. 1550  NEXT I
  57. 1560  FOR J = C1 + 1 TO C2 - 1
  58. 1570   LOCATE R1, J : PRINT CHR$(196);
  59. 1580   LOCATE R2, J : PRINT CHR$(196);
  60. 1590  NEXT J
  61. 1600   LOCATE R1, C1 : PRINT CHR$(218);
  62. 1610   LOCATE R1, C2 : PRINT CHR$(191);
  63. 1620   LOCATE R2, C1 : PRINT CHR$(192);
  64. 1630   LOCATE R2, C2 : PRINT CHR$(217);
  65. 1640  COLOR W
  66. 1650  RETURN
  67. 1700  REM ask user to press a key to continue
  68. 1710  LOCATE 25,1
  69. 1720  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  70. 1730  K$ = INKEY$ : IF K$ = "" THEN 1730
  71. 1740  KEY ON : CLS : KEY OFF
  72. 2000  REM UPDATMAR Program Starts Here.
  73. 2010  REM Open the Marriages File
  74. 2020  OPEN DD.MARR$+"marrfile" AS #2 LEN = 128
  75. 2030  REM Open the Persons File
  76. 2040  OPEN DD.PERS$+"persfile" AS #1 LEN = 256
  77. 2050  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  78. 2060  FIELD 2, 5 AS M1$, 5 AS M2$, 5 AS M3$, 5 AS M4$, 11 AS M5$, 18 AS M6$, 16 AS M7$, 16 AS M8$, 45 AS M9$
  79. 2070  REM ask the user for input
  80. 2080  LOCATE 23,1 : PRINT SPACE$(79);
  81. 2090  LOCATE 23,1 : PRINT "(0 to quit, ? to locate unused record)";
  82. 2100  LOCATE 22,1 : PRINT SPACE$(79) : LOCATE 22,1
  83. 2110  INPUT "Enter Record Number of Marriage to Update"; REPLY$
  84. 2120  IF REPLY$ <> "?" THEN 2270
  85. 2130  REM Locate an unused record
  86. 2140  FOUND = 0 : IF REC.NO = 0 THEN REC.NO = 1
  87. 2150  FOR LOOK = REC.NO TO MAX.MAR
  88. 2160   GET #2, LOOK
  89. 2170   LOCATE 15,1 : PRINT "Searching Record";LOOK;
  90. 2180   TT1 = CVS(M1$)
  91. 2190   IF TT1 > 0 THEN 2210
  92. 2200   FOUND = 1 : REC.NO = LOOK : LOOK = MAX.MAR
  93. 2210  NEXT LOOK
  94. 2220  IF FOUND = 1 THEN 2360
  95. 2230  PRINT "Unable to find an unused record above record";REC.NO
  96. 2240  PRINT "Either start from record 1 or extend the file"
  97. 2250  PRINT "Press any key to continue"
  98. 2260  GOTO 2070
  99. 2270  IF REPLY$ = "0" THEN 4810
  100. 2280  REC.NO = VAL(REPLY$)
  101. 2290  IF REC.NO < 1 OR REC.NO > MAX.MAR THEN 2300 ELSE 2350
  102. 2300  PRINT : PRINT "Number is out of range"
  103. 2310  PRINT "Press any key to continue"
  104. 2320  A$ = INKEY$ : IF A$ = "" THEN 2320
  105. 2330  KEY ON : CLS : KEY OFF
  106. 2340  GOTO 2070
  107. 2350  GET #2, REC.NO
  108. 2360  REM Extract information from the file for use
  109. 2370  TT1 = CVS(M1$)
  110. 2380  REM Disallow Update if Rec.no is Zero (never Created)
  111. 2390  IF TT1 <> 0 THEN 2460
  112. 2400  LOCATE 22,1 : PRINT SPACE$(79);
  113. 2410  LOCATE 23,1 : PRINT SPACE$(79); : LOCATE 22,1
  114. 2420  PRINT "Record Number is Zero.  Must run the CREATMAR Program First."
  115. 2430  LOCATE 25,1 : PRINT "Press any key to continue";
  116. 2440  A$ = INKEY$ : IF A$ = "" THEN 2440
  117. 2450  GOTO 4810  'Close the Files and return to the Menu
  118. 2460  TT2 = CVS(M2$)
  119. 2470  TT3 = CVS(M3$)
  120. 2480  TT4 = CVS(M4$)
  121. 2490  TT5$ = M5$
  122. 2500  TT6$ = M6$
  123. 2510  TT7$ = M7$
  124. 2520  TT8$ = M8$
  125. 2530  TT9$ = M9$
  126. 2540  KEY ON : CLS : KEY OFF
  127. 2550  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 1300  'Double box
  128. 2560  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3310  'Horizontal double
  129. 2570  R1 = 19 : C1 = 1 : R2 = 19 : C2 = 79 : GOSUB 3310  'Horizontal double
  130. 2580  LOCATE  2,33 : PRINT "Marriage Record"
  131. 2590  LOCATE  5, 3 : COLOR O : PRINT "Marriage Record-number:";
  132. 2600  LOCATE  7, 3 : PRINT "Husband's Record-number:";
  133. 2610  LOCATE  8, 3 : PRINT "Husband's Name:";
  134. 2620  LOCATE 10, 3 : PRINT "Wife's Record-number:";
  135. 2630  LOCATE 11, 3 : PRINT "Wife's Name:";
  136. 2640  LOCATE 20, 3 : PRINT "Comments:";
  137. 2650  LOCATE  5,42 : PRINT "Marriage Code:";
  138. 2660  LOCATE 13, 3 : COLOR N : PRINT "Marriage Statistics:"; : COLOR O
  139. 2670  LOCATE 14, 3 : PRINT "Marriage-date:";
  140. 2680  LOCATE 15, 3 : PRINT "Marriage-city:";
  141. 2690  LOCATE 16, 3 : PRINT "Marriage-county:";
  142. 2700  LOCATE 17, 3 : PRINT "State/Country:";
  143. 2710  GOSUB 2730 'To print the current information
  144. 2720  GOTO 3400 'For User Input
  145. 2730  REM Print the Information Currently Present
  146. 2740  LOCATE  5,27 : PRINT SPACE$(5);
  147. 2750  LOCATE  5,27 : COLOR G : PRINT TT1;
  148. 2760  LOCATE  7,27 : PRINT SPACE$(5);
  149. 2770  LOCATE  7,27 : COLOR G : PRINT TT2;
  150. 2780  LOCATE  8,27 : PRINT SPACE$(51);
  151. 2790  REM Obtain the Husband's Record
  152. 2800  IF TT2 = 0 THEN GOSUB 5230 : GOTO 2960 ELSE GET #1, TT2 : GOSUB 4960
  153. 2810  REM Disallow if not Male
  154. 2820  IF LEFT$(T4$,1) = "M" THEN 2960
  155. 2830  COLOR W
  156. 2840  LOCATE 23,1 : PRINT SPACE$(79);
  157. 2850  LOCATE 24,1 : PRINT SPACE$(70);
  158. 2860  REM Test for Undefined Sex
  159. 2870  IF LEFT$(T4$,1) <> " " THEN 2900
  160. 2880  LOCATE 22,1 : PRINT "The Sex of the Husband is Undefined"
  161. 2890  GOTO 2910
  162. 2900  LOCATE 22,1 : PRINT "The Sex of the Husband is shown as: "; T4$;
  163. 2910  LOCATE 23,1 : PRINT "Cannot Save this Marriage Record";
  164. 2920  LOCATE 25,1 : PRINT "Press any key to continue";
  165. 2930  A$ = INKEY$ : IF A$ = "" THEN 2930
  166. 2940  REM Blank the Record and start over
  167. 2950  TT1 = -TT1 : GOSUB 4860 : GOSUB 2730 : GOTO 3400
  168. 2960  LOCATE  8,27 : COLOR G : PRINT LEFT$(T3$+" "+T2$,51);
  169. 2970  LOCATE 10,27 : PRINT SPACE$(5);
  170. 2980  LOCATE 10,27 : COLOR G : PRINT TT3;
  171. 2990  LOCATE 11,27 : PRINT SPACE$(51);
  172. 3000  REM Obtain the Wife's Record
  173. 3010  IF TT3 = 0 THEN GOSUB 5230 : GOTO 3170 ELSE GET #1, TT3 : GOSUB 4960
  174. 3020  REM Disallow if not Female
  175. 3030  IF LEFT$(T4$,1) = "F" THEN 3170
  176. 3040  COLOR W
  177. 3050  LOCATE 23,1 : PRINT SPACE$(79);
  178. 3060  LOCATE 24,1 : PRINT SPACE$(70);
  179. 3070  REM Test for Undefined Sex
  180. 3080  IF LEFT$(T4$,1) <> " " THEN 3110
  181. 3090  LOCATE 22,1 : PRINT "The Sex of the Wife is Undefined"
  182. 3100  GOTO 3120
  183. 3110  LOCATE 22,1 : PRINT "The Sex of the Wife is shown as: "; T4$;
  184. 3120  LOCATE 23,1 : PRINT "Cannot Save this Marriage Record";
  185. 3130  LOCATE 25,1 : PRINT "Press any key to continue";
  186. 3140  A$ = INKEY$ : IF A$ = "" THEN 3140
  187. 3150  REM Blank the Record and start over
  188. 3160  TT1 = -TT1 : GOSUB 4860 : GOSUB 2730 : GOTO 3400
  189. 3170  LOCATE 11,27 : COLOR G : PRINT LEFT$(T3$+" "+T2$,51);
  190. 3180  LOCATE  5,57 : PRINT SPACE$(5);
  191. 3190  LOCATE  5,57 : COLOR G : PRINT TT4;
  192. 3200  LOCATE 14,28 : PRINT SPACE$(11);
  193. 3210  LOCATE 14,28 : COLOR G : PRINT LEFT$(TT5$,11);
  194. 3220  LOCATE 15,28 : PRINT SPACE$(18);
  195. 3230  LOCATE 15,28 : COLOR G : PRINT LEFT$(TT6$,18);
  196. 3240  LOCATE 16,28 : PRINT SPACE$(16);
  197. 3250  LOCATE 16,28 : COLOR G : PRINT LEFT$(TT7$,16);
  198. 3260  LOCATE 17,28 : PRINT SPACE$(16);
  199. 3270  LOCATE 17,28 : COLOR G : PRINT LEFT$(TT8$,16);
  200. 3280  LOCATE 20,20 : PRINT SPACE$(45);
  201. 3290  LOCATE 20,20 : COLOR G : PRINT LEFT$(TT9$,45); : COLOR 7
  202. 3300  RETURN
  203. 3310  REM Subroutine to draw a double horizontal line.  Attach to double.
  204. 3320  COLOR P
  205. 3330  FOR J = C1 + 1 TO C2 - 1
  206. 3340   LOCATE R1,J : PRINT CHR$(205);
  207. 3350  NEXT J
  208. 3360  LOCATE R1,C1 : PRINT CHR$(204);
  209. 3370  LOCATE R1,C2 : PRINT CHR$(185);
  210. 3380  COLOR W
  211. 3390  RETURN
  212. 3400  REM Routines to Obtain information from the User
  213. 3410  LOCATE 22,1 : PRINT SPACE$(79);
  214. 3420  LOCATE 23,1 : PRINT SPACE$(79);
  215. 3430  LOCATE 24,1 : PRINT SPACE$(79);
  216. 3440  LOCATE 25,1 : PRINT SPACE$(79);
  217. 3450  LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown)";
  218. 3460  LOCATE 23,1
  219. 3470  INPUT "Enter the Record Number";REPLY$
  220. 3480  IF REPLY$ = "/" THEN 4440
  221. 3490  IF REPLY$ = "" THEN 3600
  222. 3500  IF ABS(VAL(REPLY$)) = ABS(TT1) THEN 3570 ELSE 3510
  223. 3510  REM Prevent Change of Rec.no
  224. 3520  LOCATE 24,1 : PRINT SPACE$(79); : LOCATE 22,1
  225. 3530  PRINT "Cannot Change the Record Number to another number.";
  226. 3540  LOCATE 25,1 : PRINT "Press any key to continue";
  227. 3550  A$ = INKEY$ : IF A$ = "" THEN 3550
  228. 3560  GOTO 3400
  229. 3570  TT1 = VAL(REPLY$)
  230. 3580  IF TT1 < 1 THEN GOSUB 4860 : GOSUB 2730 : GOTO 4440  'Null Record
  231. 3590  GOSUB 2730
  232. 3600  LOCATE 23,1 : PRINT SPACE$(79);
  233. 3610  REM Terminate record update if negative
  234. 3620  IF TT1 < 1 THEN 4440
  235. 3630  LOCATE 23,1 : COLOR W
  236. 3640  INPUT "Enter the Husband's Persons Record-Number";REPLY$
  237. 3650  IF REPLY$ = "/" THEN 4440
  238. 3660  IF REPLY$ = "" THEN 3720
  239. 3670  TT2 = VAL(REPLY$)
  240. 3680  IF TT2 >= 0 AND TT2 <= MAX.PER THEN 3700
  241. 3690  LOCATE 22,1 : PRINT "Number out of range"; : GOTO 3600
  242. 3700  LOCATE 22,1 : PRINT SPACE$(79);
  243. 3710  GOSUB 2760
  244. 3720  LOCATE 23,1 : PRINT SPACE$(79);
  245. 3730  REM Disallow if Husband's Record-number is zero
  246. 3740  IF TT2 <> 0 THEN 3820
  247. 3750  COLOR W : LOCATE 24,1 : PRINT SPACE$(79);
  248. 3760  LOCATE 22,1 : PRINT "Husband's Record Number Cannot be Zero";
  249. 3770  LOCATE 23,1 : PRINT "Cannot Save this Marriage Record";
  250. 3780  LOCATE 25,1 : PRINT "Press any key to continue";
  251. 3790  A$ = INKEY$ : IF A$ = "" THEN 3790
  252. 3800  REM Blank the Record and start over
  253. 3810  TT1 = -TT1 : GOSUB 4860 : GOSUB 2730 : GOTO 3400
  254. 3820  LOCATE 23,1 : PRINT SPACE$(79);
  255. 3830  LOCATE 23,1 : COLOR W
  256. 3840  INPUT "Enter the Wife's Persons Record-Number";REPLY$
  257. 3850  IF REPLY$ = "/" THEN 4440
  258. 3860  IF REPLY$ = "" THEN 3920
  259. 3870  TT3 = VAL(REPLY$)
  260. 3880  IF TT3 >= 0 AND TT3 <= MAX.PER THEN 3900
  261. 3890  LOCATE 22,1 : PRINT "Number out of range"; : GOTO 3820
  262. 3900  LOCATE 22,1 : PRINT SPACE$(79);
  263. 3910  GOSUB 2970
  264. 3920  LOCATE 23,1 : PRINT SPACE$(79);
  265. 3930  REM Disallow if Wife's Record-number is zero
  266. 3940  IF TT3 <> 0 THEN 4020
  267. 3950  COLOR W : LOCATE 24,1 : PRINT SPACE$(79);
  268. 3960  LOCATE 22,1 : PRINT "Wife's Record Number Cannot be Zero";
  269. 3970  LOCATE 23,1 : PRINT "Cannot Save this Marriage Record";
  270. 3980  LOCATE 25,1 : PRINT "Press any key to continue";
  271. 3990  A$ = INKEY$ : IF A$ = "" THEN 3990
  272. 4000  REM Blank the Record and start over
  273. 4010  TT1 = -TT1 : GOSUB 4860 : GOSUB 2730 : GOTO 3400
  274. 4020  LOCATE 23,1 : COLOR W
  275. 4030  INPUT "Enter the Marriage Code";REPLY$
  276. 4040  IF REPLY$ = "/" THEN 4440
  277. 4050  IF REPLY$ = "" THEN 4080
  278. 4060  TT4 = VAL(REPLY$)
  279. 4070  GOSUB 3180
  280. 4080  LOCATE 23,1 : PRINT SPACE$(79);
  281. 4090  LOCATE 23,1 : COLOR W
  282. 4100  INPUT "Enter the Marriage-Date as: dd Mmm yyyy";REPLY$
  283. 4110  IF REPLY$ = "/" THEN 4440
  284. 4120  IF REPLY$ = "" THEN 4150
  285. 4130  RSET TT5$ = REPLY$
  286. 4140  GOSUB 3200
  287. 4150  LOCATE 23,1 : PRINT SPACE$(79);
  288. 4160  LOCATE 23,1 : COLOR 7
  289. 4170  INPUT "Enter the Marriage-city";REPLY$
  290. 4180  IF REPLY$ = "/" THEN 4440
  291. 4190  IF REPLY$ = "" THEN 4220
  292. 4200  TT6$ = REPLY$
  293. 4210  GOSUB 3220
  294. 4220  LOCATE 23,1 : PRINT SPACE$(79);
  295. 4230  LOCATE 23,1 : COLOR 7
  296. 4240  INPUT "Enter the Marriage-county";REPLY$
  297. 4250  IF REPLY$ = "/" THEN 4440
  298. 4260  IF REPLY$ = "" THEN 4290
  299. 4270  TT7$ = REPLY$
  300. 4280  GOSUB 3240
  301. 4290  LOCATE 23,1 : PRINT SPACE$(79);
  302. 4300  LOCATE 23,1 : COLOR 7
  303. 4310  INPUT "Enter the Marriage-State or Country:";REPLY$
  304. 4320  IF REPLY$ = "/" THEN 4440
  305. 4330  IF REPLY$ = "" THEN 4360
  306. 4340  TT8$ = REPLY$
  307. 4350  GOSUB 3260
  308. 4360  LOCATE 23,1 : PRINT SPACE$(79);
  309. 4370  LOCATE 23,1 : COLOR 7
  310. 4380  INPUT "Enter any Comments";REPLY$
  311. 4390  IF REPLY$ = "/" THEN 4440
  312. 4400  IF REPLY$ = "" THEN 4430
  313. 4410  TT9$ = REPLY$
  314. 4420  GOSUB 3280
  315. 4430  REM
  316. 4440  REM Completed this Record
  317. 4450  LOCATE 24,1 : PRINT SPACE$(79);
  318. 4460  LOCATE 23,1 : PRINT SPACE$(79);
  319. 4470  LOCATE 23,1 : COLOR W
  320. 4480  INPUT "Type s (save), m (more), or f (forget)";REPLY$
  321. 4490  IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3400
  322. 4500  IF LEFT$(REPLY$,1) = "M" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3400
  323. 4510  IF LEFT$(REPLY$,1) = "f" THEN KEY ON : CLS : KEY OFF : GOTO 2070
  324. 4520  IF LEFT$(REPLY$,1) = "F" THEN KEY ON : CLS : KEY OFF : GOTO 2070
  325. 4530  IF LEFT$(REPLY$,1) = "s" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 4570
  326. 4540  IF LEFT$(REPLY$,1) = "S" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 4570
  327. 4550  LOCATE 22,1 : PRINT "Error in reply";
  328. 4560  GOTO 4460
  329. 4570  REM Routine to SAVE the newly updated record
  330. 4580  REM Prevent saving of Person/non-Person Marriage
  331. 4590  IF TT1 < 0 THEN 4690  'ok if empty
  332. 4600  IF TT2 = 0 OR TT3 = 0 THEN 4610 ELSE 4690
  333. 4610  LOCATE 22,1 : PRINT SPACE$(79);
  334. 4620  LOCATE 22,1
  335. 4630  PRINT "Cannot s (save) unless both spouses have numbers that are not zero."
  336. 4640  REM Ask for More or Forget, but not Save
  337. 4650  LOCATE 23,1 : PRINT SPACE$(79);
  338. 4660  LOCATE 23,1 : COLOR W
  339. 4670  INPUT "Type m (more), or f (forget)"; REPLY$
  340. 4680  GOTO 4490
  341. 4690  LSET M1$  = MKS$(TT1)
  342. 4700  LSET M2$  = MKS$(TT2)
  343. 4710  LSET M3$  = MKS$(TT3)
  344. 4720  LSET M4$  = MKS$(TT4)
  345. 4730  RSET M5$  = TT5$
  346. 4740  LSET M6$  = TT6$
  347. 4750  LSET M7$  = TT7$
  348. 4760  LSET M8$  = TT8$
  349. 4770  LSET M9$  = TT9$
  350. 4780  PUT #2, REC.NO
  351. 4790  KEY ON : CLS : KEY OFF
  352. 4800  GOTO 2070
  353. 4810  CLOSE #2
  354. 4820  CLOSE #1
  355. 4830  KEY ON : CLS : KEY OFF : LOCATE 21,1
  356. 4840  PRINT "End of Program"
  357. 4850  RUN DD.MENU$+"menu"
  358. 4860  REM Blank a Negative Record
  359. 4870  TT2 = 0
  360. 4880  TT3 = 0
  361. 4890  TT4 = 0
  362. 4900  TT5$ = ""
  363. 4910  TT6$ = ""
  364. 4920  TT7$ = ""
  365. 4930  TT8$ = ""
  366. 4940  TT9$ = ""
  367. 4950  RETURN
  368. 4960  REM Routine to Extract Personal Information
  369. 4970  T1 = CVS(F1$)
  370. 4980  T2$ = F2$
  371. 4990  FOR J = 1 TO LEN(F2$) -1
  372. 5000   IF RIGHT$(T2$,1)=" " THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
  373. 5010  T3$ = F3$
  374. 5020  NEXT J
  375. 5030  FOR J = 1 TO LEN(F3$) -1
  376. 5040   IF RIGHT$(T3$,1)=" " THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  377. 5050  NEXT J
  378. 5060  T4$ = F4$
  379. 5070  T5 = CVS(F5$)
  380. 5080  T6 = CVS(F6$)
  381. 5090  T7 = CVS(F7$)
  382. 5100  T8$ = F8$
  383. 5110  T9$ = F9$
  384. 5120  T10$ = F10$
  385. 5130  T11$ = F11$
  386. 5140  T12$ = F12$
  387. 5150  T13$ = F13$
  388. 5160  T14$ = F14$
  389. 5170  T15$ = F15$
  390. 5180  T16$ = F16$
  391. 5190  T17$ = F17$
  392. 5200  T18$ = F18$
  393. 5210  T19$ = F19$
  394. 5220  RETURN
  395. 5230  REM Blank out a Record
  396. 5240  T1 = 0
  397. 5250  T2$ = ""
  398. 5260  T3$ = ""
  399. 5270  T4$ = ""
  400. 5280  T5 = 0
  401. 5290  T6 = 0
  402. 5300  T7 = 0
  403. 5310  T8$ = ""
  404. 5320  T9$ = ""
  405. 5330  T10$ = ""
  406. 5340  T11$ = ""
  407. 5350  T12$ = ""
  408. 5360  T13$ = ""
  409. 5370  T14$ = ""
  410. 5380  T15$ = ""
  411. 5390  T16$ = ""
  412. 5400  T17$ = ""
  413. 5410  T18$ = ""
  414. 5420  T19$ = ""
  415. 5430  RETURN
  416.